Imports System.Security.Cryptography
Imports System.Text
Imports System.Text.RegularExpressions

Module Mdl_Guvenlik

    Private Declare Function GetVolumeSerialNumber Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Integer, ByRef lpVolumeSerialNumber As Integer, ByRef lpMaximumComponentLength As Integer, ByRef lpFileSystemFlags As Integer, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Integer) As Integer

    Public Function Disk_Serial(ByVal RootPath As String) As String
        Dim VolLabel As String = Nothing
        Dim VolSize As Integer
        Dim Serial As Integer
        Dim MaxLen As Integer
        Dim Flags As Integer
        Dim Name_Renamed As String = Nothing
        Dim NameSize As Integer
        Dim s As String
        Dim ret As Boolean
        ret = GetVolumeSerialNumber(RootPath, VolLabel, VolSize, Serial, MaxLen, Flags, Name_Renamed, NameSize)
        If ret Then
            s = Hex(Serial)
            If s.Length < 8 Then
                s = s & Space(8 - s.Length)
            ElseIf s.Length > 8 Then
                s = Mid(s, 1, 8)
            End If
            s = s & "#"
            Return s
        Else
            Return "00000000#"
        End If
    End Function

    Function KeyGen(ByRef kNamev As Object, ByRef kPass As String, ByRef kType As Short) As String
        On Error Resume Next 'still here just as a precaution
        Dim cTable(512) As Short 'character map
        Dim nKeys(16) As Short 'xor keys used for pArray(x) xor nkeys(x)
        Dim s0(512) As Short 'swap-box data used to map character table
        Dim nArray(16) As Short 'name array data
        Dim pArray(16) As Short 'password array data
        Dim n As Short 'for next loop counter
        Dim nPtr As Short 'name pointer (used for counting)
        Dim cPtr As Short 'character pointer (used for counting)
        Dim cFlip As Boolean 'character flip (used to flip between numeric and alpha)
        Dim sIni As Short 'holds s-box values
        Dim temp As Short 'holds s-box values
        Dim rtn As Short 'holds generated key values used agains chr map
        Dim gKey As String 'generated key as string
        Dim nLen As Short 'number of chr's in name
        Dim pLen As Short 'number of chr's in password
        Dim kPtr As Short 'key pointer
        Dim sPtr As Short 'space pointer (used in hex key)
        Dim nOffset As Short 'name offset
        Dim pOffset As Short 'password offset
        Dim tOffset As Short 'total offset
        Dim KeySize As Short 'the size of the key to make

        Const nXor As Short = 18 'name xor value
        Const pXor As Short = 25 'password xor value
        Const cLw As Short = 65 'character lower limit 65 = A ** do not change **
        Const nLw As Short = 48 'number lower limit 48 = 0 ** do not change **
        Const sOffset As Short = 0 'character map offset

        Dim VarType_Renamed As String
        Dim kName As String = ""
        Dim AryCtl As Short
        Dim AryCtrl As System.Windows.Forms.Control

        VarType_Renamed = TypeName(kNamev)

        Select Case VarType_Renamed
            Case "String"
                kName = kNamev
            Case "TextBox"
                kName = kNamev
            Case "Object"
                For Each AryCtrl In kNamev
                    If AryCtrl.Text <> "" Then
                        kName = kName & AryCtrl.Text & "|"
                    End If
                Next AryCtrl
                kName = Left(kName, Len(kName) - 1)
            Case "String()"
                For AryCtl = LBound(kNamev) To UBound(kNamev)
                    If kNamev <> "" Then
                        kName = kName & kNamev & "|"
                    End If
                Next
                kName = Left(kName, Len(kName) - 1)
            Case Else
                MsgBox(VarType_Renamed & " is an unsupported type to be passed to KeyGen")
        End Select
        '****************************************************************************

        nLen = Len(kName)
        pLen = Len(kPass)

        nKeys(1) = 46
        nKeys(2) = 89
        nKeys(3) = 142
        nKeys(4) = 63
        nKeys(5) = 231
        nKeys(6) = 32
        nKeys(7) = 129
        nKeys(8) = 51
        nKeys(9) = 28
        nKeys(10) = 97
        nKeys(11) = 248
        nKeys(12) = 41
        nKeys(13) = 136
        nKeys(14) = 53
        nKeys(15) = 78
        nKeys(16) = 164

        sIni = 0

        'set s boxes
        For n = 0 To 512
            s0(n) = n
        Next n

        For n = 0 To 512
            sIni = (sOffset + sIni + n) Mod 256
            temp = s0(n)
            s0(n) = s0(sIni)
            s0(sIni) = temp
        Next n

        If kType = 1 Then '(numeric)

            nPtr = 0
            KeySize = 16
            gKey = New String(" ", 16)

            For n = 0 To 512
                cTable(s0(n)) = (nLw + (nPtr))
                nPtr = nPtr + 1
                If nPtr = 10 Then nPtr = 0
            Next n



        ElseIf kType = 2 Then  '(alphanumeric)

            nPtr = 0
            cPtr = 0
            KeySize = 16
            gKey = New String(" ", 16)

            cFlip = False
            For n = 0 To 512
                If cFlip Then
                    cTable(s0(n)) = (nLw + nPtr)
                    nPtr = nPtr + 1
                    If nPtr = 10 Then nPtr = 0
                    cFlip = False
                Else
                    cTable(s0(n)) = (cLw + cPtr)
                    cPtr = cPtr + 1
                    If cPtr = 26 Then cPtr = 0
                    cFlip = True
                End If
            Next n



        Else '(hex)

            KeySize = 8
            gKey = New String(" ", 19)

        End If

        kPtr = 1

        For n = 1 To nLen 'name
            nArray(kPtr) = nArray(kPtr) + Asc(Mid(kName, n, 1)) Xor nXor
            nOffset = nOffset + nArray(kPtr)
            kPtr = kPtr + 1
            If kPtr = 9 Then kPtr = 1
        Next n

        For n = 1 To pLen 'password
            pArray(kPtr) = pArray(kPtr) + Asc(Mid(kPass, n, 1)) Xor pXor
            pOffset = pOffset + pArray(kPtr)
            kPtr = kPtr + 1
            If kPtr = 9 Then kPtr = 1
        Next n

        tOffset = (nOffset + pOffset) Mod 512

        kPtr = 1
        sPtr = 1
        For n = 1 To KeySize
            pArray(n) = pArray(n) Xor nKeys(n)
            rtn = System.Math.Abs(((nArray(n) Xor pArray(n)) Mod 512) - tOffset)

            If kType = 3 Then 'hex key
                If rtn < 16 Then
                    Mid(gKey, kPtr, 2) = "0" & Hex(rtn)
                Else
                    Mid(gKey, kPtr, 2) = Hex(rtn)
                End If
                If sPtr = 2 And kPtr < 18 Then
                    kPtr = kPtr + 1
                    Mid(gKey, kPtr + 1, 1) = "-"
                End If
                kPtr = kPtr + 2
                sPtr = sPtr + 1
                If sPtr = 3 Then sPtr = 1
            Else 'numeric - alphanumeric key
                Mid(gKey, n, 1) = Chr(cTable(rtn))
            End If
        Next

        KeyGen = gKey

    End Function

    Public Function EncryptSHA(ByVal Data As String) As String
        Dim shaM As New SHA1Managed
        Convert.ToBase64String(shaM.ComputeHash(Encoding.ASCII.GetBytes(Data)))
        Dim eNC_data() As Byte = ASCIIEncoding.ASCII.GetBytes(Data)
        Dim eNC_str As String = Convert.ToBase64String(eNC_data)
        EncryptSHA = eNC_str
    End Function
    Public Function DecryptSHA(ByVal Data As String) As String
        Try
            Dim dEC_data() As Byte = Convert.FromBase64String(Trim(Data))
            Dim dEC_Str As String = ASCIIEncoding.ASCII.GetString(dEC_data)
            DecryptSHA = dEC_Str
        Catch ex As Exception
            Return ex.Message
        End Try
    End Function


    'Public Function GetLisans_No_Kontrol() As Boolean
    '    Dim sonuc As Boolean = False
    '    Try
    '        If Lisans_Tbl_Kontrol() = True Then
    '            Dim machkod As String = ""
    '            Dim regcode As String = ""

    '            Dim cn As New SqlConnection(Cnn_String)
    '            Dim rd As SqlDataReader
    '            Dim cmd As New SqlCommand
    '            cmd.Connection = cn
    '            cn.Open()
    '            cmd.CommandText = "SELECT * FROM PW_LISANS"
    '            rd = cmd.ExecuteReader

    '            If rd.HasRows = True Then
    '                rd.Read()
    '                machkod = DecryptSHA(rd(0))
    '                regcode = DecryptSHA(rd(1))
    '            End If
    '            cn.Close()
    '            rd.Close()



    '            Dim kontrolkey As String = KeyGen(machkod, "1951", 3)


    '            kontrolkey = kontrolkey.Replace("-", "")

    '            If kontrolkey = regcode Then
    '                Dim k1, k2 As Integer
    '                k1 = InStr(1, machkod, "#")
    '                k2 = InStr(k1 + 1, machkod, "#")
    '                Demo_Kullanim_Suresi = Mid(machkod, k1 + 1, k2 - k1 - 1)
    '                License_User_Count = Mid(machkod, k2 + 1, Len(regcode))

    '                sonuc = True
    '            Else
    '                sonuc = False
    '            End If
    '        Else
    '            Lisans_Tbl_Create()
    '            sonuc = False
    '        End If
    '        Return sonuc
    '    Catch ex As Exception
    '        Dim frmerr As New Frm_Error_Reporting
    '        frmerr.Error_Handling(ex)
    '        MsgBox(ex.Message)
    '    End Try
    'End Function

End Module
